home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / API_for_be879395282002.psc / API is Easy / ModVBControls.bas < prev    next >
Encoding:
BASIC Source File  |  2002-05-28  |  4.8 KB  |  104 lines
  1. Attribute VB_Name = "ModVBControls"
  2. 'API declares
  3. Private Declare Function GetWindowLong& Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long)
  4. Private Declare Function SetWindowLong& Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long)
  5. Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  6. 'API constants
  7. 'Textbox
  8. Private Const ES_NUMBER = &H2000&
  9. Private Const ES_LOWERCASE = &H10&
  10. Private Const ES_UPPERCASE = &H8&
  11. 'Listview
  12. Private Const HDS_BUTTONS As Long = &H2
  13. Private Const LVM_FIRST As Long = &H1000
  14. Private Const LVM_GETHEADER As Long = (LVM_FIRST + 31)
  15. 'Treeview
  16. Private Const TVS_NOTOOLTIPS = &H80
  17. 'Commandbutton
  18. Private Const BS_FLAT = &H8000&
  19. Private Const BS_NULL = 1
  20. 'Progressbar
  21. Private Const WM_USER = &H400
  22. Private Const PBM_SETBARCOLOR = (WM_USER + 9)
  23. Private Const CCM_FIRST = &H2000
  24. Private Const CCM_SETBKCOLOR = (CCM_FIRST + 1)
  25. 'Type of style to change - normal
  26. Private Const GWL_STYLE = (-16)
  27. 'variables
  28. Public mHover As Boolean
  29. Dim InitTBStyle As Long, InitLVStyle As Long, InitTVStyle As Long
  30. Dim InitBTStyle As Long, InitPBStyle As Long, hHeader As Long
  31. Public Sub NumberOnly(Tbox As TextBox)
  32.     'Set the style, which window?, what style - normal or extended?, new style
  33.     SetWindowLong& Tbox.hWnd, GWL_STYLE, InitTBStyle Or ES_NUMBER
  34. End Sub
  35. Public Sub LowercaseOnly(Tbox As TextBox)
  36.     'Set the style, which window?, what style - normal or extended?, new style
  37.     SetWindowLong& Tbox.hWnd, GWL_STYLE, InitTBStyle Or ES_LOWERCASE
  38. End Sub
  39. Public Sub UppercaseOnly(Tbox As TextBox)
  40.     'Set the style, which window?, what style - normal or extended?, new style
  41.     SetWindowLong& Tbox.hWnd, GWL_STYLE, InitTBStyle Or ES_UPPERCASE
  42. End Sub
  43. Public Sub SetInitialTBStyle(Tbox As TextBox)
  44.     'Set the style, which window?, what style - normal or extended?, original style
  45.     SetWindowLong& Tbox.hWnd, GWL_STYLE, InitTBStyle
  46. End Sub
  47. Public Sub GetInitialTBStyle(Tbox As TextBox)
  48.     'variable = Get the style, which window?, what style - normal or extended?
  49.     InitTBStyle = GetWindowLong&(Tbox.hWnd, GWL_STYLE)
  50. End Sub
  51. Public Sub SetInitialLVStyle(LV As ListView)
  52.     'Set the style, which window?, what style - normal or extended?, original style
  53.     SetWindowLong& hHeader, GWL_STYLE, InitLVStyle
  54. End Sub
  55. Public Sub GetInitialLVStyle(LV As ListView)
  56.     hHeader = SendMessage(LV.hWnd, LVM_GETHEADER, 0, ByVal 0&) 'handle to column header
  57.     'variable = Get the style, which window?, what style - normal or extended?
  58.     InitLVStyle = GetWindowLong&(hHeader, GWL_STYLE)
  59. End Sub
  60. Public Sub LVFlatColumnHeaders(LV As ListView)
  61.     'Set the style, which window?, what style - normal or extended?, new style
  62.     SetWindowLong hHeader, GWL_STYLE, InitLVStyle Xor HDS_BUTTONS
  63. End Sub
  64. Public Sub SetInitialTVStyle(TV As TreeView)
  65.     'Set the style, which window?, what style - normal or extended?, original style
  66.     SetWindowLong& TV.hWnd, GWL_STYLE, InitTVStyle
  67. End Sub
  68. Public Sub GetInitialTVStyle(TV As TreeView)
  69.     'variable = Get the style, which window?, what style - normal or extended?
  70.     InitTVStyle = GetWindowLong&(TV.hWnd, GWL_STYLE)
  71. End Sub
  72. Public Sub TVNoTooltips(TV As TreeView)
  73.     'Set the style, which window?, what style - normal or extended?, new style
  74.     SetWindowLong TV.hWnd, GWL_STYLE, InitTVStyle Or TVS_NOTOOLTIPS
  75. End Sub
  76. Public Sub SetInitialBTStyle(BT As CommandButton)
  77.     'if the style is already the original then dont do it again, may cause some flashing
  78.     If GetWindowLong&(BT.hWnd, GWL_STYLE) = InitBTStyle Then Exit Sub
  79.     'Set the style, which window?, what style - normal or extended?, original style
  80.     SetWindowLong& BT.hWnd, GWL_STYLE, InitBTStyle
  81.     BT.Refresh
  82. End Sub
  83. Public Sub GetInitialBTStyle(BT As CommandButton)
  84.     'variable = Get the style, which window?, what style - normal or extended?
  85.     InitBTStyle = GetWindowLong&(BT.hWnd, GWL_STYLE)
  86. End Sub
  87. Public Sub BTFlat(BT As CommandButton)
  88.     'if the style is already the BS_FLAT then dont do it again, may cause some flashing
  89.     If GetWindowLong&(BT.hWnd, GWL_STYLE) And BS_FLAT Then Exit Sub
  90.     'Set the style, which window?, what style - normal or extended?, new style
  91.     SetWindowLong BT.hWnd, GWL_STYLE, InitBTStyle Or BS_FLAT
  92.     BT.Refresh
  93. End Sub
  94. Public Sub BTThick(BT As CommandButton)
  95.     'Set the style, which window?, what style - normal or extended?, new style
  96.     SetWindowLong BT.hWnd, GWL_STYLE, InitBTStyle Or BS_NULL
  97.     BT.Refresh
  98. End Sub
  99. Public Sub PBcolor(PB As ProgressBar, Backcolor As Long, Forecolor As Long)
  100.     'Send a message, which window?, what type of message, message value
  101.     SendMessage PB.hWnd, CCM_SETBKCOLOR, 0, ByVal Backcolor
  102.     SendMessage PB.hWnd, PBM_SETBARCOLOR, 0, ByVal Forecolor
  103. End Sub
  104.